home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Toolbox
/
Visual Basic Toolbox (P.I.E.)(1996).ISO
/
message
/
msgbxcls
/
msgbxtst.frm
< prev
next >
Wrap
Text File
|
1996-01-06
|
24KB
|
769 lines
VERSION 4.00
Begin VB.Form frmMsgBoxTest
BorderStyle = 3 'Fixed Dialog
Caption = "MsgBox Class Test Project"
ClientHeight = 6150
ClientLeft = 1140
ClientTop = 1560
ClientWidth = 6765
Height = 6585
Icon = "MSGBXTST.frx":0000
Left = 1065
MaxButton = 0 'False
ScaleHeight = 410
ScaleMode = 3 'Pixel
ScaleWidth = 451
ShowInTaskbar = 0 'False
Top = 1200
Width = 6915
Begin VB.TextBox txtObjectName
Height = 285
Left = 5520
TabIndex = 33
Text = "MB"
Top = 3930
Width = 1005
End
Begin VB.TextBox txtGeneratedCode
Height = 915
Left = 270
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 35
Top = 4860
Width = 6285
End
Begin VB.Frame fmeCallFormat
Caption = "Call Format"
Height = 885
Left = 240
TabIndex = 26
Top = 3810
Width = 2415
Begin VB.OptionButton optCallFormat
Caption = "Set Properties First"
Height = 225
Index = 0
Left = 240
TabIndex = 27
Top = 240
Value = -1 'True
Width = 1950
End
Begin VB.OptionButton optCallFormat
Caption = "Use Values In-line"
Height = 225
Index = 1
Left = 240
TabIndex = 28
Top = 510
Width = 1950
End
End
Begin VB.Frame fmeCallType
Caption = "Call Type"
Height = 885
Left = 2880
TabIndex = 29
Top = 3810
Width = 1725
Begin VB.OptionButton optCallType
Caption = "Sub"
Height = 255
Index = 0
Left = 240
TabIndex = 30
Top = 240
Value = -1 'True
Width = 1155
End
Begin VB.OptionButton optCallType
Caption = "Function"
Height = 255
Index = 1
Left = 240
TabIndex = 31
Top = 510
Width = 1155
End
End
Begin VB.CommandButton cmdGenerateCall
Caption = "&Generate Call"
Height = 360
Left = 4890
TabIndex = 34
Top = 4350
Width = 1665
End
Begin VB.Frame fmeIcon
Caption = "Icon"
Height = 2205
Left = 4890
TabIndex = 18
Top = 1230
Width = 1665
Begin VB.OptionButton optIcon
Caption = "In&formation"
Height = 225
Index = 4
Left = 240
TabIndex = 23
Top = 1500
Width = 1275
End
Begin VB.OptionButton optIcon
Caption = "E&xclamation"
Height = 225
Index = 3
Left = 240
TabIndex = 22
Top = 1200
Width = 1275
End
Begin VB.OptionButton optIcon
Caption = "&Question"
Height = 225
Index = 2
Left = 240
TabIndex = 21
Top = 900
Width = 1275
End
Begin VB.OptionButton optIcon
Caption = "Cr&itical"
Height = 225
Index = 1
Left = 240
TabIndex = 20
Top = 600
Width = 1275
End
Begin VB.OptionButton optIcon
Caption = "Non&e"
Height = 225
Index = 0
Left = 240
TabIndex = 19
Top = 300
Value = -1 'True
Width = 1275
End
End
Begin VB.Frame fmeModality
Caption = "Modality"
Height = 885
Left = 2880
TabIndex = 15
Top = 2550
Width = 1725
Begin VB.OptionButton optModality
Caption = "&System"
Height = 255
Index = 1
Left = 240
TabIndex = 17
Top = 510
Width = 1155
End
Begin VB.OptionButton optModality
Caption = "&Application"
Height = 255
Index = 0
Left = 240
TabIndex = 16
Top = 240
Value = -1 'True
Width = 1155
End
End
Begin VB.Frame fmeDefaultButton
Caption = "Default Button"
Height = 1275
Left = 2880
TabIndex = 11
Top = 1230
Width = 1725
Begin VB.OptionButton optDefaultButton
Caption = "Button &3"
Height = 255
Index = 2
Left = 240
TabIndex = 14
Top = 900
Width = 1215
End
Begin VB.OptionButton optDefaultButton
Caption = "Button &2"
Height = 255
Index = 1
Left = 240
TabIndex = 13
Top = 600
Width = 1215
End
Begin VB.OptionButton optDefaultButton
Caption = "Button &1"
Height = 255
Index = 0
Left = 240
TabIndex = 12
Top = 300
Value = -1 'True
Width = 1215
End
End
Begin VB.CommandButton cmdTestMsgBox
Caption = "Test Message Box"
Height = 360
Left = 4890
TabIndex = 24
Top = 255
Width = 1665
End
Begin VB.CommandButton cmdClose
Caption = "Close"
Height = 360
Left = 4890
TabIndex = 25
Top = 705
Width = 1665
End
Begin VB.Frame fmeButtons
Caption = "Buttons"
Height = 2205
Left = 210
TabIndex = 4
Top = 1230
Width = 2415
Begin VB.OptionButton optButtons
Caption = "&Retry + Cancel"
Height = 225
Index = 5
Left = 240
TabIndex = 10
Top = 1800
Width = 1950
End
Begin VB.OptionButton optButtons
Caption = "Yes + &No"
Height = 225
Index = 4
Left = 240
TabIndex = 9
Top = 1500
Width = 1950
End
Begin VB.OptionButton optButtons
Caption = "&Yes + No + Cancel"
Height = 225
Index = 3
Left = 240
TabIndex = 8
Top = 1200
Width = 1950
End
Begin VB.OptionButton optButtons
Caption = "A&bort + Retry +Ignore"
Height = 225
Index = 2
Left = 240
TabIndex = 7
Top = 900
Width = 1950
End
Begin VB.OptionButton optButtons
Caption = "OK + &Cancel"
Height = 225
Index = 1
Left = 240
TabIndex = 6
Top = 600
Width = 1950
End
Begin VB.OptionButton optButtons
Caption = "&OK only"
Height = 225
Index = 0
Left = 240
TabIndex = 5
Top = 300
Value = -1 'True
Width = 1950
End
End
Begin VB.TextBox txtTitle
Height = 285
Left = 1320
TabIndex = 1
Text = "Test Title"
Top = 330
Width = 1425
End
Begin VB.TextBox txtMessage
Height = 285
Left = 1320
TabIndex = 3
Text = "Test Message"
Top = 750
Width = 3285
End
Begin VB.Label lblObject
BackStyle = 0 'Transparent
Caption = "Object:"
Height = 255
Left = 4920
TabIndex = 32
Top = 3990
Width = 495
End
Begin VB.Line linHorzSep
BorderColor = &H00808080&
Index = 1
X1 = 14
X2 = 436
Y1 = 246
Y2 = 246
End
Begin VB.Line linHorzSep
BorderColor = &H00FFFFFF&
Index = 0
X1 = 14
X2 = 436
Y1 = 244
Y2 = 244
End
Begin VB.Label lblStatusBar
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Copyright ⌐ 1995-1996 Gregg Irwin. All Rights Reserved."
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 400
size = 9.75
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 240
Left = 240
TabIndex = 36
Top = 5850
Width = 4980
End
Begin VB.Label lblTitle
BackStyle = 0 'Transparent
Caption = "&Title:"
Height = 225
Left = 270
TabIndex = 0
Top = 360
Width = 885
End
Begin VB.Label lblMessage
BackStyle = 0 'Transparent
Caption = "&Message:"
Height = 225
Left = 270
TabIndex = 2
Top = 780
Width = 885
End
End
Attribute VB_Name = "frmMsgBoxTest"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
'
' MsgBox Class Test Project
' Copyright ⌐ 1995-1996 Gregg Irwin. All Rights Reserved.
'
Option Explicit
DefInt A-Z
Const STYLE_OP_BUTTON = 0
Const STYLE_OP_DEF_BUTTON = 1
Const STYLE_OP_MODALITY = 2
Const STYLE_OP_ICON = 3
Const OPT_BTN_OK_ONLY = 0
Const OPT_BTN_OK_CANCEL = 1
Const OPT_BTN_ABORT_RETRY_IGNORE = 2
Const OPT_BTN_YES_NO_CANCEL = 3
Const OPT_BTN_YES_NO = 4
Const OPT_BTN_RETRY_CANCEL = 5
Const OPT_DEF_BTN_1 = 0
Const OPT_DEF_BTN_2 = 1
Const OPT_DEF_BTN_3 = 2
Const OPT_DEF_BTN_4 = 3
Const OPT_ICON_NONE = 0
Const OPT_ICON_CRITICAL = 1
Const OPT_ICON_QUESTION = 2
Const OPT_ICON_EXCLAMATION = 3
Const OPT_ICON_INFORMATION = 4
Const OPT_MODALITY_APP = 0
Const OPT_MODALITY_SYSTEM = 1
Const CALL_TYPE_SUB = 0
Const CALL_TYPE_FUNCTION = 1
Const CALL_FORMAT_SET_PROPS_FIRST = 0
Const CALL_FORMAT_USE_VALS_INLINE = 1
Const DEF_OBJECT_NAME = "MB"
Private mStyleOp(3) As Long '-- selected Style options
'=======================================================
'== EVENTS
'=======================================================
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdGenerateCall_Click()
Dim ObjName As String
Dim GenCode As String
ObjName = txtObjectName.Text
If ObjName = "" Then
ObjName = DEF_OBJECT_NAME
End If
GenCode = ""
GenCode = GenCode & "Dim " & ObjName & " As New clsMsgBox" & vbCrLf
GenCode = GenCode & "Dim " & ObjName & "Rtn As Integer" & vbCrLf
GenCode = GenCode & vbCrLf
Select Case GetCallFormat()
Case CALL_FORMAT_SET_PROPS_FIRST
GenCode = GenCode & "With " & ObjName & vbCrLf
GenCode = GenCode & " .Title = " & Chr$(34) & txtTitle.Text & Chr$(34) & vbCrLf
GenCode = GenCode & " .Message = " & Chr$(34) & txtMessage.Text & Chr$(34) & vbCrLf
GenCode = GenCode & " .Style = " & GenerateStyleCode() & vbCrLf
GenCode = GenCode & "End With" & vbCrLf
Select Case GetCallType()
Case CALL_TYPE_SUB
GenCode = GenCode & ObjName & ".ShowModal" & vbCrLf
Case CALL_TYPE_FUNCTION
GenCode = GenCode & ObjName & "Rtn = " & ObjName & ".ShowModal" & vbCrLf
GenCode = GenCode & GenerateRtnCodeHandler(ObjName) & vbCrLf
Case Else
End Select
Case CALL_FORMAT_USE_VALS_INLINE
Select Case GetCallType()
Case CALL_TYPE_SUB
GenCode = GenCode & ObjName & ".ShowModal "
GenCode = GenCode & " StyleFlags := (" & GenerateStyleCode() & "),"
GenCode = GenCode & " Msg := " & Chr$(34) & txtMessage.Text & Chr$(34) & ", "
GenCode = GenCode & " BoxTitle := " & Chr$(34) & txtTitle.Text & Chr$(34)
GenCode = GenCode & vbCrLf
Case CALL_TYPE_FUNCTION
GenCode = GenCode & ObjName & "Rtn = " & ObjName & ".ShowModal ("
GenCode = GenCode & " StyleFlags := (" & GenerateStyleCode() & "),"
GenCode = GenCode & " Msg := " & Chr$(34) & txtMessage.Text & Chr$(34) & ", "
GenCode = GenCode & " BoxTitle := " & Chr$(34) & txtTitle.Text & Chr$(34) & ")"
GenCode = GenCode & vbCrLf
GenCode = GenCode & GenerateRtnCodeHandler(ObjName) & vbCrLf
Case Else
End Select
Case Else
End Select
txtGeneratedCode = GenCode
End Sub
Private Sub cmdTestMsgBox_Click()
Dim MB As New clsMsgBox
Dim Style As Long
Dim i As Integer
Dim Cap As String
Dim Msg As String
Dim MBRtn As Integer '-- MsgBox Return Value
'-- Accumulate all the selected style settings
For i = LBound(mStyleOp) To UBound(mStyleOp)
Style = Style + mStyleOp(i)
Next i
'-- Set message and title
Msg = txtMessage.Text
Cap = txtTitle.Text
'-- Display the message box
MBRtn = MB.ShowModal(Msg, Style, Cap, (Me.HWnd))
'-- Display the return value
lblStatusBar.Caption = MsgBoxReturnCodeDesc(MBRtn) & " was selected"
End Sub
Private Sub Form_Load()
'-- Center the form on the screen
Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
End Sub
Private Sub optButtons_Click(Index As Integer)
'-- The control array index values just happen
' to match the values we need.
mStyleOp(STYLE_OP_BUTTON) = Index
Select Case Index
Case OPT_BTN_OK_ONLY
Call SetCallType(CALL_TYPE_SUB)
Case Else
Call SetCallType(CALL_TYPE_FUNCTION)
End Select
End Sub
Private Sub optDefaultButton_Click(Index As Integer)
'-- The control array index values just happen
' to match the values we need (when multiplied
' by 256).
mStyleOp(STYLE_OP_DEF_BUTTON) = Index * 256
End Sub
Private Sub optIcon_Click(Index As Integer)
'-- The control array index values just happen
' to match the values we need (when multiplied
' by 16).
mStyleOp(STYLE_OP_ICON) = Index * 16
End Sub
Private Sub optModality_Click(Index As Integer)
'-- The control array index values just happen
' to match the values we need (when multiplied
' by 4096).
mStyleOp(STYLE_OP_MODALITY) = Index * 4096
End Sub
'=======================================================
'== INTERNAL SUPPORT PROCEDURES
'=======================================================
' MsgBoxReturnCodeDesc()
Private Function MsgBoxReturnCodeDesc(MsgBoxRtnCode As Integer) As String
Dim Desc As String
Select Case MsgBoxRtnCode
Case vbAbort
Desc = "Abort"
Case vbCancel
Desc = "Cancel"
Case vbIgnore
Desc = "Ignore"
Case vbNo
Desc = "No"
Case vbOK
Desc = "OK"
Case vbRetry
Desc = "Retry"
Case vbYes
Desc = "Yes"
Case Else
Desc = "Unknown (" & CStr(MsgBoxRtnCode) & ")"
End Select
MsgBoxReturnCodeDesc = Desc
End Function
' SetCallType
Private Sub SetCallType(CallType As Integer)
Select Case CallType
Case CALL_TYPE_SUB
optCallType(0).Value = True
Case CALL_TYPE_FUNCTION
optCallType(1).Value = True
Case Else
End Select
End Sub
' GetCallType()
Private Function GetCallType() As Integer
If optCallType(0).Value = True Then
GetCallType = CALL_TYPE_SUB
Else
GetCallType = CALL_TYPE_FUNCTION
End If
End Function
' GetCallFormat()
Private Function GetCallFormat() As Integer
If optCallFormat(0).Value = True Then
GetCallFormat = CALL_FORMAT_SET_PROPS_FIRST
Else
GetCallFormat = CALL_FORMAT_USE_VALS_INLINE
End If
End Function
' GetButtonStyleOption()
Private Function GetButtonStyleOption() As Integer
GetButtonStyleOption = mStyleOp(STYLE_OP_BUTTON)
End Function
' GetDefaultButtonStyleOption()
Private Function GetDefaultButtonStyleOption() As Integer
GetDefaultButtonStyleOption = mStyleOp(STYLE_OP_DEF_BUTTON) \ 256
End Function
' GetIconStyleOption()
Private Function GetIconStyleOption() As Integer
GetIconStyleOption = mStyleOp(STYLE_OP_ICON) \ 16
End Function
' GetModalityStyleOption()
Private Function GetModalityStyleOption() As Integer
GetModalityStyleOption = mStyleOp(STYLE_OP_MODALITY) \ 4096
End Function
' GenerateStyleCode()
Private Function GenerateStyleCode() As String
Dim BtnStyle As String
Dim DefBtnStyle As String
Dim IconStyle As String
Dim ModalStyle As String
Dim GenStyle As String
Select Case GetButtonStyleOption()
Case OPT_BTN_OK_ONLY
BtnStyle = "vbOKOnly"
Case OPT_BTN_OK_CANCEL
BtnStyle = "vbOKCancel"
Case OPT_BTN_ABORT_RETRY_IGNORE
BtnStyle = "vbAbortRetryIgnore"
Case OPT_BTN_YES_NO_CANCEL
BtnStyle = "vbYesNoCancel"
Case OPT_BTN_YES_NO
BtnStyle = "vbYesNo"
Case OPT_BTN_RETRY_CANCEL
BtnStyle = "vbRetryCancel"
Case Else
BtnStyle = ""
End Select
Select Case GetDefaultButtonStyleOption()
Case OPT_DEF_BTN_1
'-- Default value. No need to generate code
'DefBtnStyle = "vbDefaultButton1"
Case OPT_DEF_BTN_2
DefBtnStyle = "vbDefaultButton2"
Case OPT_DEF_BTN_3
DefBtnStyle = "vbDefaultButton3"
Case OPT_DEF_BTN_4
DefBtnStyle = "vbDefaultButton4"
Case Else
DefBtnStyle = ""
End Select
Select Case GetIconStyleOption()
Case OPT_ICON_NONE
'-- Default value. No need to generate code
'IconStyle = ""
Case OPT_ICON_CRITICAL
IconStyle = "vbCritical"
Case OPT_ICON_QUESTION
IconStyle = "vbQuestion"
Case OPT_ICON_EXCLAMATION
IconStyle = "vbExclamation"
Case OPT_ICON_INFORMATION
IconStyle = "vbInformation"
Case Else
IconStyle = ""
End Select
Select Case GetModalityStyleOption()
Case OPT_MODALITY_APP
'-- Default value. No need to generate code
'ModalStyle = "vbApplicationModal"
Case OPT_MODALITY_SYSTEM
ModalStyle = "vbSystemModal"
Case Else
ModalStyle = ""
End Select
GenStyle = ""
If Len(BtnStyle) Then
GenStyle = GenStyle & BtnStyle
End If
If Len(DefBtnStyle) Then
GenStyle = GenStyle & " + " & DefBtnStyle
End If
If Len(IconStyle) Then
GenStyle = GenStyle & " + " & IconStyle
End If
If Len(ModalStyle) Then
GenStyle = GenStyle & " + " & ModalStyle
End If
GenerateStyleCode = GenStyle
End Function
' GenerateRtnCodeHandler()
Private Function GenerateRtnCodeHandler(ObjName As String) As String
Dim GenHandler As String
GenHandler = ""
GenHandler = "Select Case " & ObjName & "Rtn" & vbCrLf
Select Case GetButtonStyleOption()
Case OPT_BTN_OK_ONLY
GenHandler = GenHandler & " Case vbOK" & vbCrLf
Case OPT_BTN_OK_CANCEL
GenHandler = GenHandler & " Case vbOK" & vbCrLf
GenHandler = GenHandler & " Case vbCancel" & vbCrLf
Case OPT_BTN_ABORT_RETRY_IGNORE
GenHandler = GenHandler & " Case vbAbort" & vbCrLf
GenHandler = GenHandler & " Case vbRetry" & vbCrLf
GenHandler = GenHandler & " Case vbIgnore" & vbCrLf
Case OPT_BTN_YES_NO_CANCEL
GenHandler = GenHandler & " Case vbYes" & vbCrLf
GenHandler = GenHandler & " Case vbNo" & vbCrLf
GenHandler = GenHandler & " Case vbCancel" & vbCrLf
Case OPT_BTN_YES_NO
GenHandler = GenHandler & " Case vbYes" & vbCrLf
GenHandler = GenHandler & " Case vbNo" & vbCrLf
Case OPT_BTN_RETRY_CANCEL
GenHandler = GenHandler & " Case vbRetry" & vbCrLf
GenHandler = GenHandler & " Case vbCancel" & vbCrLf
Case Else
End Select
GenHandler = GenHandler & " Case Else" & vbCrLf
GenHandler = GenHandler & "End Select"
GenerateRtnCodeHandler = GenHandler
End Function
